(FILECREATED "16-AUG-73 13:46:35" PUP)
(DEFINEQ
(PURE
[QLAMBDA (TUPLE (TUPLE ←A
←←B)←←C)
(QIF (QEQUAL $A COMMENT)
ELSE (PRINT (TUPLE $A $$B)))
(QIF (QEQUAL $C (TUPLE))
ELSE (PURE (TUPLE $$C])
(RAMIFICATIONS
[QLAMBDA
(TUPLE ←A
←B)
(QPROG (←L
←NEXT
←S1
←S2
←S3)
(QMATCHQ ←L
(QINSTANCES ←←ANY))
B1
(QATTEMPT (QMATCHQ (CLASS ←NEXT
←←L)
$L)
ELSE (QRETURN TRUE))
B2
[QATTEMPT (QMATCHQ (TUPLE ←←S1
$A ←←S2
$B ←←S3)
$NEXT)
THEN (QPROG NIL (QDELETE (TUPLE $$S1 $A $$S2 $B $$S3))
(QASSERT (TUPLE $$S1 $B $$S2 $A $$S3))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$B ←←S2
$A ←←S3)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $B $$S2 $A $$S3))
(QASSERT (TUPLE $$S1 $A $$S2 $B $$S3))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$A ←←S2)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $A $$S2))
(QASSERT (TUPLE $$S1 $B $$S2))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$B ←←S2)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $B
$$S2))
(QASSERT (TUPLE $$S1 $A
$$S2]
B3
(QATTEMPT (QMATCHQ (TUPLE ←←S1
(TUPLE ←←NEXT)←←S2)
$NEXT)
THEN (GOTO B2)
ELSE (GOTO B1])
(OUTTUPLE
[LAMBDA (S)
(COND
((ATOM S)
S)
((EQUAL (CAR S)
(QUOTE TUPLE))
(OUTTUPLE (CDR S)))
(T (CONS (OUTTUPLE (CAR S))
(OUTTUPLE (CDR S])
(EXECUTE
[LAMBDA (I)
[EVAL (LIST (QUOTE DEFINEQ)
(LIST $NAME (APPEND (LIST (QUOTE LAMBDA)
(LIST $L)
(LIST (QUOTE SETQ)
(QUOTE EX)
$L))
I]
(($NAME (EVAL EX])
(LISPTRANSLATE
[QLAMBDA ←E
(EVAL (CDR (SASSOC $E
(QUOTE (((TUPLE FIRST ELEMENT)
TUPLE CAR $L)
((TUPLE LAST ELEMENT)
TUPLE LAST $L)
((TUPLE SECOND ELEMENT)
TUPLE CADR $L)
((TUPLE ALL BUT THE FIRST ELEMENT)
TUPLE CDR $L)
((TUPLE ALL BUT THE FIRST TWO
ELEMENTS)
TUPLE CDDR $L)
((TUPLE ALL BUT THE SECOND
ELEMENT)
TUPLE CONS (TUPLE CAR $L)
(TUPLE CDDR $L))
((TUPLE ALL BUT THE SINGLETON
LIST OF THE FIRST ELEMENT)
TUPLE CDR $L)
((TUPLE ALL BUT THE CLOSEST
ELEMENT
TO A)
TUPLE PULLOUT
(TUPLE EXTREMORD1 $L $RELNN)
$L)
((TUPLE ALL BUT THE SMALLEST
ELEMENT)
TUPLE PULLOUT
(TUPLE EXTREMORD1 $L $RELNN)
$L)
((TUPLE SMALLEST ELEMENT)
TUPLE EXTREMORD1 $L $RELNN)
((TUPLE CLOSEST ELEMENT
TO A)
TUPLE EXTREMORD1 $L $RELNN)
((TUPLE SINGLETON LIST OF THE
LAST ELEMENT)
TUPLE LIST (TUPLE LAST $L))
((TUPLE SINGLETON LIST OF THE
FIRST ELEMENT)
TUPLE LIST (TUPLE CAR $L))
($E. (PRINT (TUPLE COMMENT SORRY
I CANNOT
TRANSLATE $E])
(REV2ELS
(QLAMBDA (TUPLE ←RELN
←A
←B)
(QIF (QAND (QEQUAL (QGET $RELN PARTIAL)
TRUE)
(QEQUAL (QGET $RELN ANTISYM)
TRUE))
ELSE (QFAIL))
(QATTEMPT (QEXISTS (TUPLE $RELN $B $A))
ELSE (TRANSITIVECLOSURE (TUPLE $RELN $B $A)))
(QEXISTS (TUPLE C $A ←ACON))
(QEXISTS (TUPLE C $B ←BCON))
(QGOAL (TUPLE SERIES (TUPLE C $A $BCON)
(TUPLE C $B $ACON))
APPLY $GOALTYPE)))
(CELLEQUAL
(QLAMBDA (CLASS ←A
←B)
(QAND (QATTEMPT (QEXISTS (TUPLE C $A ←VAL1)))
(QATTEMPT (QEXISTS (TUPLE C $B ←VAL2)))
(QMATCHQ $VAL1 $VAL2))))
(LISTEQUAL
[QLAMBDA (CLASS ←A
←B)
(QPROG (←E1
←E2
←E3
←E4)
(QATTEMPT (QMATCHQ (TUPLE ←E1
←←E2)
$A)
THEN (QMATCHQ (TUPLE ←E3
←←E4)
$B)
ELSE (QATTEMPT (QMATCHQ (TUPLE ←E3
←←E4)
$B)
THEN (QRETURN FALSE)
ELSE (QRETURN TRUE)))
(QIF (QAND (CELLEQUAL (CLASS $E1 $E3))
(LISTEQUAL (CLASS $E2 $E4)))
THEN (QRETURN TRUE)
ELSE (QRETURN FALSE])
(PULLOUT
[LAMBDA (E L)
(COND
((EQUAL E (CAR L))
(CDR L))
(T (CONS (CAR L)
(PULLOUT E (CDR L])
(NUMERORDER
[LAMBDA (A B)
(ALPHORDER A B])
(EXTREMORD
(QLAMBDA (TUPLE ←L
←RELNN)
(QATTEMPT (QMATCHQ (TUPLE ←X
←Y
←←Z)
$L)
THEN (IF ($RELNN $X $Y)
THEN (EXTREMORD (TUPLE (TUPLE $X $$Z)
$RELNN))
ELSE (EXTREMORD (TUPLE (TUPLE $Y $$Z)
$RELNN)))
ELSE (CDR $L))))
(ORDERING
(QLAMBDA ←L
(QMATCHQ ←S
(TUPLE IDENTITY))
(QMATCHQ ←E1
(TUPLE FIRST ELEMENT))
(QMATCHQ ←E2
(EXTREMEORDERING $RELNN))
(PRINT (TUPLE
IN PARTICULAR THE $$E1 OF THE NEW LIST $L IS THE
$$E2 OF THE
OLD LIST $L))
(QMATCHQ ←RECBODY
(POSITIONALJOIN (TUPLE $E2 (ALLBUT $E2)
$E1)))
(PRINT (QUOTE (THIS ENABLED US TO GET THE RECURSIVE BODY)))
(PRINT $RECBODY)
(PRINT (QUOTE (WE NOW DETERMINE THE TERMINATION STEPS)))
(QMATCHQ ←NEWFUNC
(RECHEAD $RECBODY))
(EVAL (PRINT $NEWFUNC))
(QMATCHQ ←PGM
(TUPLE $NEWFUNC $$PGM))))
(EXTREMEORDERING
(QLAMBDA ←RELN
(QGET (TUPLE RELN $RELN)
EXTREME)))
(NEWCDR
[LAMBDA (L)
(COND
(L (CDR L))
(T (RETFROM (QUOTE EXECUTE)
(QUOTE ((BREAKING OUT OF NEWCDR])
(REASONTOGET
[QLAMBDA ←A
(IF (AND (ZEROP (LENGTH $SET))
(QMATCHQ ←SET
(EVAL $SET)))
THEN (AND (QMATCHQ (TUPLE ←FUNC)
$A)
($FUNC $SET))
ELSE (AND (PRINT (TUPLE SORRY CANNOT GET $$A OF $SET))
(QFAIL])
(FINITE
(QLAMBDA ←SET
(EQUAL (QGET $SET FINITE)
T)))
(UPPERBOUND
(QLAMBDA ←SET
(COND
((FINITE $SET)
(EXTREMORD (TUPLE $SET NUMERORDER)))
((QATTEMPT (QMATCHQ (TUPLE THE NEGATIVE ←←ANY)
$SET))
-1)
((QATTEMPT (QMATCHQ (TUPLE THE NONPOSITIVE ←←ANY)
$SET))
0)
((REASONTOGET (TUPLE UPPERBOUND)))
(T NIL))))
(MONOTONEIN
[QLAMBDA (TUPLE ←FUNC
←VAR)
(QPROG NIL (IF (OR (EQUAL $FUNC $VAR)
(EQUAL $FUNC $X)
(QGET (TUPLE RELN $FUNC)
MONOTONE))
THEN (RETURN T))
(QMATCHQ (TUPLE ←F1
←←F)
$FUNC)
(RETURN (AND (MONOTONEIN (TUPLE (TUPLE $F1)
$VAR))
(MONOTONEIN (TUPLE $F2 $VAR])
(NEGATION
[QLAMBDA ←EXPRES
(QBEXISTS (TUPLE RELN ←REL)
THEN (PROGN (QMATCHQ ←NEWREL
(QGET (TUPLE RELN $REL)
NEGATION))
(QMATCHQ (TUPLE ←←A1
$REL ←←A2)
$EXPRES)
(TUPLE $$A1 ?NEWREL $$A2])
(PREVERSE
(QLAMBDA (TUPLE ←←P)
(QPROG NIL (QMATCHQ ←PCOP
(TUPLE))
LOOP
(QATTEMPT (QMATCHQ (TUPLE ←P1
←←P)
$P)
ELSE (RETURN $PCOP))
(QMATCHQ ←PCOP
(TUPLE $P1 $$PCOP))
(GO LOOP))))
(SQUARE
[LAMBDA (A)
(TIMES A A])
(REPLACE
[QLAMBDA (TUPLE ←OLD
←NEW
INEXPRESSION ←EXP)
(QATTEMPT (QMATCHQ (TUPLE ←←A1
$OLD ←←A2)
$EXP)
THEN (TUPLE $$A1 $NEW $$A2)
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←A1
(TUPLE ←←A2
$OLD ←←A3)←←A4)
$EXP)
THEN (TUPLE $$A1 (TUPLE $$A2 $NEW $$A3)
$$A4)
ELSE (AND (PRINT (TUPLE SORRY
IF $EXP CONTAINS $OLD IT IS
IN TOO DEEPLY
FOR ME
TO SEE IT)
$EXP])
(NOTENEWFORM
(QLAMBDA ←ANY
(PRINT (TUPLE OUR PROBLEM $DESC IS SIMPLIFIED INTO $NEWDESC
WHICH IS JUSTIFIED SINCE $CONDITION IS TRUE))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT PROBLEM $DESC IS SIMPLIFIED
INTO $NEWDESC BY JUSTIFICATION
$CONDITION)
$$PGM))
$ANY))
(RECURNUM
[QLAMBDA (TUPLE ←NAME
←ARG)
(IF (NUMBERP $ARG)
ELSE (QFAIL))
(QATTEMPT (QEXISTS (TUPLE RELN $NAME)
TYPE NUM KNOWN T)
THEN (IF (QGET (TUPLE RELN $NAME)
COMPUTABLE)
THEN ($NAME $ARG)
ELSE (NEWRECURNUM (TUPLE $NAME $ARG)))
ELSE (NEWRECURNUM (TUPLE $NAME $ARG])
(NEWRECURNUM
[QLAMBDA
(TUPLE ←NAME
←ARG)
(QPROG NIL
(PRINT (TUPLE WE ARE DEFINING A FUNCTION $NAME WHICH IS
NUMERIC
IN CHARACTER, SO PLEASE DESCRIBE THE DOMAIN
AND RANGE:))
(PRINT (QUOTE "DOMAIN...."))
(SETQ LDOMAIN (CONS (RATOM)
(READLINE)))
(QMATCHQ ←DOMAIN
(TUPLE (EVAL LDOMAIN)))
(QMATCHQ (TUPLE ←DOMAIN
←←ANY)
$DOMAIN)
(PRIN1 (QUOTE "RANGE ..."))
(SETQ LRANGE (CONS (RATOM)
(READLINE)))
(QMATCHQ (TUPLE ←RANGE
←←ANY)
(TUPLE (EVAL LRANGE)))
(QMATCHQ (CLASS ←X
←←UNUSEDARGS)
$UNUSEDARGS)
READESC
(PRINT (TUPLE SUPPOSE Y =(TUPLE $NAME $X)))
(PRINT (TUPLE DESCRIBE Y IN TERMS OF $X))
(SETQ LDESC (CONS (RATOM)
(READLINE)))
(QMATCHQ (TUPLE ←DESC
←←ANYTHING)
(TUPLE (EVAL LDESC)))
(PRINT (TUPLE DESCRIPTION IS $DESC RANGE IS $RANGE DOMAIN IS
$DOMAIN))
(QASSERT (TUPLE RELN $NAME)
TYPE NUM DOMAIN $DOMAIN RANGE $RANGE KNOWN T FACTS
(TUPLE $DESC)
COMPUTABLE T DEFINITION NIL)
(QMATCHQ (TUPLE ←RELN1
←ARG1
←CONNECTIVE
←GOAL)
$DESC)
(PRINT (TUPLE RELN1 IS $RELN1 ARG1 IS $ARG1 CONNECTIVE IS
$CONNECTIVE GOAL IS $GOAL A1 A2 ARE ?A1 ?A2))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT OUR GOAL IS CURRENTLY $GOAL)
$$PGM))
GETPLAN
(QMATCHQ ←GOAL
(MAKECOMPUTABLE $GOAL))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT OUR GOAL IS CURRENTLY $GOAL)
$$PGM))
(QMATCHQ ←DESC
(TUPLE $RELN1 $ARG1 $CONNECTIVE $GOAL))
[QATTEMPT (EVAL (QGET (TUPLE RELN $RELN1)
COMPUTABLE))
THEN (RETURN (OPTIMIZE
(TUPLE $NAME (IMPLEMENT
(QGET (TUPLE RELN $RELN1)
DEFINITION]
(QMATCHQ ←TEMP
(QGET (TUPLE RELN $RELN1)
FACTS))
(QMATCHQ (TUPLE ←←A1
(TUPLE ←OLD1
BECOMES ←NEW1 IF ←CONDIT1)←←A2)
$TEMP)
(QMATCHQ ←OLD
(EVAL $OLD1))
(QMATCHQ ←NEW
(EVAL $NEW1))
(QMATCHQ ←CONDIT
(EVAL $CONDIT1))
(QMATCHQ (TUPLE $DESC BECOMES ←NEWDESC IF ←CONDITION)
(TUPLE $OLD BECOMES $NEW IF $CONDIT))
(PRINT (TUPLE WE GET THE NEW DESCRIPTION OF OUR TASK
TO BE $NEWDESC))
(QMATCHQ (TUPLE ←RELN1
←ARG1
←CONNECTIVE
←GOAL)
$NEWDESC)
(PRINT (TUPLE RELN IS NOW $RELN1 ARG IS NOW $ARG1 CONNECTIVE
IS NOW $CONNECTIVE GOAL IS NOW $GOAL))
(IF (HOLDS $CONDITION)
THEN (AND (NOTENEWFORM)
(QMATCHQ ←DESC
$NEWDESC)
(GO GETPLAN))
ELSE (GO READESC])
(NEWCAR
[LAMBDA (L)
(COND
(L (CAR L))
(T (RETFROM (QUOTE EXECUTE)
(QUOTE (BREAKING OUT OF NEWCAR])
(NEWCARCDR
[LAMBDA (L)
(COND
((NULL L)
NIL)
[(EQUAL (CAR L)
(QUOTE CDDR))
(CONS (QUOTE NEWCDR)
(LIST (CONS (QUOTE NEWCDR)
(NEWCARCDR (CDR L]
(T (CONS [COND
[(ATOM (CAR L))
(COND
((EQUAL (CAR L)
(QUOTE CAR))
(QUOTE NEWCAR))
((EQUAL (CAR L)
(QUOTE CDR))
(QUOTE NEWCDR))
(T (CAR L]
(T (NEWCARCDR (CAR L]
(NEWCARCDR (CDR L])
(ASKABOUTALL
(QLAMBDA (CLASS ←A
←←ALLTHEREST)
(ASKABOUT $A)
(QATTEMPT (QMATCHQ (CLASS)
$ALLTHEREST)
THEN [QMATCHQ ←AALH
(TUPLE (TUPLE COND $$TERM (TUPLE T $BODY]
ELSE (ASKABOUTALL $ALLTHEREST))))
(NONEOF
[QLAMBDA (CLASS NONEOF ←Z)
(COND
((EQUAL $Z (CLASS))
T)
(T (QMATCHQ (CLASS ←Z1
←←REST)
$Z)
(AND (NOT (QEXISTS $Z1))
(QGOAL (CLASS NONEOF $$REST)
APPLY $GOALTYPE])
(INVOLVES
(QLAMBDA (TUPLE ←T1
←T2)
(SUBLISTC (FLATTEN $T1)
(FLATTEN $T2))))
(FLATTEN
[LAMBDA (L)
(COND
((ATOM L)
(LIST L))
(T (APPEND (FLATTEN (CAR L))
(FLATTEN (CDR L])
(INSIDEC
[LAMBDA (E L)
(COND
((NULL L)
NIL)
((EQUAL E (CAR L))
T)
((AND (LISTP (CAR L))
(INSIDEC E (CAR L)))
T)
(T (INSIDEC E (CDR L])
(SUBLISTC
[LAMBDA (L1 L2)
(COND
((NULL L1)
T)
((NULL L2)
NIL)
((INSIDEC (CAR L1)
L2)
(SUBLISTC (CDR L1)
L2])
(APPENDC
(QLAMBDA (TUPLE ←FRONTLIST
←OLDLIST)
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE JUST TOOK LIST $FRONTLIST
AND APPENDED IT ONTO FRONT OF LIST
$OLDLIST)
(TUPLE SETQ $OLDLIST (TUPLE APPEND
$FRONTLIST
$OLDLIST))
$$PGM))))
(REPLACECDR
(QLAMBDA (TUPLE LIST ←L
←NEWCDR
←OLDCDR
←CAR)
(QDELETE (TUPLE LIST $L (TUPLE $CAR $$OLDCDR)))
(QASSERT (TUPLE LIST $L (TUPLE $CAR $$NEWCDR)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE REPLACE CDR OF LIST $L
WHICH WAS $OLDCDR BY $NEWCDR)
(TUPLE RPLACD $NEWCDR $L)
$$PGM))))
(REPLACECAR
(QLAMBDA (TUPLE LIST ←L
←NEWCAR
←OLDCAR
←CDR)
(QMATCHQ ←NEWLIST
(TUPLE $NEWCAR $$CDR))
(QMATCHQ ←OLDLIST
(TUPLE $OLDCAR $$CDR))
(QDELETE (TUPLE LIST $L $OLDLIST))
(QASSERT (TUPLE LIST $L $NEWLIST))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE REPLACE CAR OF LIST $L
WHICH WAS $OLDCAR
BY THE CELL $NEWCAR)
(TUPLE RPLACA $NEWCAR $L)
$$PGM))))
(MAKENULL
(QLAMBDA (TUPLE LIST ←L
(TUPLE))
(QATTEMPT (QEXISTS (TUPLE LIST $L ←ANY))
THEN (QDELETE (TUPLE LIST $L $ANY)))
(QASSERT (TUPLE LIST $L (TUPLE)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE SET LIST $L TO NULL)
(TUPLE SETQ $L NIL)
$$PGM))))
(RPLAC
[QLAMBDA (TUPLE LIST ←L
(TUPLE ←CAR
←←CDR))
(QEXISTS (TUPLE LIST $L (TUPLE ←←CURRENT)))
(QMATCHQ (TUPLE ←CURCAR
←←CURCDR)
$CURRENT)
(QIF (LISTEQUAL (CLASS $CURCDR $CDR))
THEN (REPLACECAR (TUPLE LIST $L $CAR $CURCAR $CDR))
ELSE (QIF (CELLEQUAL (CLASS $CURCAR $CAR))
THEN (REPLACECDR (TUPLE LIST $L $CDR $CURCDR $CAR)
)
ELSE (QFAIL])
(NEWCELL
[QLAMBDA (TUPLE ←VAL
←LOC)
(QPROG (←AUXLOC)
(QMATCHQ (CLASS ←AUXLOC
←←UNUSEDVARS)
$UNUSEDVARS)
(QASSERT (TUPLE C $AUXLOC $VAL))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I MAY NEED $VAL LATER
SO BEFORE I STORE SOMETHING
IN LOCATION $LOC I AM TRANSFERRING
$VAL
TO THE NEWLY CREATED LOCATION
$AUXLOC)
(TUPLE SETQ $AUXLOC $LOC)
$$PGM])
(ALLBUT
[QLAMBDA ←E
(QATTEMPT (QMATCHQ $S (TUPLE IDENTITY))
THEN (TUPLE ALL BUT THE $$E)
ELSE (QATTEMPT (QMATCHQ $S DOUBLEFN)
THEN (AND (QMATCHQ (TUPLE ←←ANY
ELEMENT)
$E)
(TUPLE ALL BUT THE $$ANY TWO ELEMENTS))
ELSE (AND (PRINT (QUOTE (SORRY BUT I CANNOT HANDLE
SCHEMA $S YET)))
(QFAIL])
(STORECVALUE
[QLAMBDA ←LOC
(QPROG (←VALU
←RESERVE)
(QATTEMPT (QEXISTS (TUPLE C $LOC ←VALU))
THEN (QATTEMPT (QBEXISTS
(TUPLE C ←RESERVE
$VALU)
THEN
(QIF (QEQUAL $RESERVE $LOC)
THEN (QFAIL)
ELSE (QPUT (TUPLE C
$RESERVE
$VALU)
NEEDED TRUE)))
ELSE (NEWCELL (TUPLE $VALU $LOC)))
ELSE (QRETURN TRUE])
(CONSC
[QLAMBDA
(TUPLE LIST ←L
(TUPLE ←CAR
←←CDR))
(QPROG
(←M
←S1
←S2)
(QATTEMPT (QGOAL (TUPLE LIST $L $CDR)
APPLY $GOALTYPE)
THEN (QATTEMPT
(QEXISTS (TUPLE LIST ←M
(TUPLE ←←S1
$CAR ←←S2)))
THEN [QPROG (←M2
←T)
(QMATCHQ ←T
(GETNEWLOCNAME))
(QDELETE (TUPLE LIST $L $CDR))
(QMATCHQ ←M2
(TUPLE $T $$CDR))
(QASSERT (TUPLE LIST $L $M2))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE JUST
TOOK THE NEW CELL
$T
AND CONSED IT
ONTO $L
SINCE $CAR
ALREADY
BELONGS
TO ANOTHER LIST
STRUCTURE NAMELY
$M)
(TUPLE SETQ $T $CAR)
(TUPLE SETQ L
(TUPLE CONS $T $L)
)
$$PGM))
(QATTEMPT (QEXISTS (TUPLE C $CAR ←M2))
THEN (QASSERT (TUPLE C $T $M2]
ELSE (QPROG (←TEMP)
(QDELETE (TUPLE LIST $L $CDR))
(QMATCHQ ←TEMP
(TUPLE $CAR $$CDR))
(QASSERT (TUPLE LIST $L $TEMP))
(QATTEMPT
(QEXISTS (TUPLE LIST $CAR ←←ANYTHING))
THEN (APPENDC (TUPLE $CAR $L))
ELSE (QMATCHQ
←PGM
(TUPLE (TUPLE COMMENT WE JUST
TOOK $CAR
AND CONSED IT
ONTO LIST $L)
(TUPLE SETQ $L
(TUPLE CONS $CAR $L)
)
$$PGM])
(SETQC
[QLAMBDA (TUPLE C ←NEWLOC
←NEWVAL)
(QPROG (←OLDLOC
←LOC2
←V)
[QATTEMPT (QEXISTS (TUPLE C ←OLDLOC
$NEWVAL))
ELSE (QPROG NIL
(QMATCHQ (TUPLE ←←A
(TUPLE COMMENT ←VOLD
NO LONGER HAS
THE VALUE
$NEWVAL)
(TUPLE ←←B)
(TUPLE ←←C)←←D)
$PGM)
(QMATCHQ (CLASS ←OLDLOC
←←UNUSEDVARS)
$UNUSEDVARS)
(QASSERT (TUPLE C $OLDLOC $NEWVAL))
(QMATCHQ ←PGM
(TUPLE $$A
(TUPLE COMMENT $VOLD NO
LONGER HAS THE
VALUE $NEWVAL
BUT SINCE WE
WILL BE NEEDING
IT LATER WE
STORED $NEWVAL
IN THE NEW
AUXILLIARY CELL
$OLDLOC)
(TUPLE $$B)
(TUPLE $$C)
(TUPLE SETQ $OLDLOC
$VOLD)
$$D]
(QATTEMPT (QEXISTS (TUPLE C ←LOC2
$NEWVAL)
NEEDED TRUE)
ELSE (QPUT (TUPLE C $OLDLOC $NEWVAL)
NEEDED TRUE))
(BUILDPGM (TUPLE $NEWLOC $NEWVAL $OLDLOC))
(QDELETE (TUPLE C $NEWLOC ←V))
(QASSERT (TUPLE C $NEWLOC $NEWVAL])
(TRANSITIVECLOSURE
[QLAMBDA (TUPLE ←RELN
←A
←B)
(QIF (QEQUAL (QGET (TUPLE $RELN TRANSITIVE))
TRUE)
ELSE (QFAIL))
(QBEXISTS (TUPLE $RELN $A ←ANY)
THEN (QIF (QEQUAL $ANY $B)
THEN (QASSERT (TUPLE $RELN $A $B))
ELSE (TRANSITIVECLOSURE (TUPLE $RELN $ANY $B])
(TRYANYTHINGANTISYMPARTIAL
(QLAMBDA (TUPLE ←TYPE
←←STUFF
(TUPLE ←RELN
←A
←B)←←STUFF2)
(QIF (QAND (QGET $RELN ANTISYM)
(QGET $RELN PARTIAL))
ELSE (QFAIL))
(QIF (QOR (QATTEMPT (QEXISTS (TUPLE $RELN $A $B))
THEN (QNOTEQUAL (QGET (TUPLE $RELN $A $B)
TEMP)
TRUE))
(QATTEMPT (QEXISTS (TUPLE $RELN $B $A))
THEN (QNOTEQUAL (QGET (TUPLE $RELN $B $A)
TEMP)
TRUE)))
THEN (QFAIL))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT IF $A $RELN $B
THEN)
(TUPLE COND (TUPLE $RELN $A $B))
$$PGM))
(QASSERT (TUPLE $RELN $A $B))
(QPUT (TUPLE $RELN $A $B)
TEMP TRUE)
(QATTEMPT (QGOAL (TUPLE $TYPE $$STUFF (TUPLE $RELN $A $B)
$$STUFF2)
APPLY $GOALTYPE)
ELSE (QMATCHQ ←PGM
(TUPLE (TUPLE PRINT GIVEUP)
$$PGM)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT END OF THE
THEN PART OF THE COND
AND THUS BEGIN THE
ELSE PART OF THE COND)
(TUPLE (TUPLE T))
$$PGM))
(QDELETE (TUPLE $RELN $A $B))
(QASSERT (TUPLE $RELN $B $A))
(QPUT (TUPLE $RELN $B $A)
TEMP TRUE)
(QATTEMPT (QGOAL (TUPLE $TYPE $$STUFF (TUPLE $RELN $A $B)
$$STUFF2)
APPLY $GOALTYPE)
ELSE (QMATCHQ ←PGM
(TUPLE (TUPLE PRINT GIVEUP)
$$PGM)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT END OF COND EXPRESSION)
$$PGM))
(QDELETE (TUPLE $RELN $B $A))
BACKTRACK))
(SIMPLEGOAL
[QLAMBDA ←ANYTHING
(QGOAL $ANYTHING APPLY $LITTLEGUYS)
(COND
(REQUIRE (QPUT $ANYTHING REQUIRED TRUE])
(SOLVE
(QLAMBDA ←PROBLEM
(QGOAL $PROBLEM APPLY $GOALTYPE)
(QATTEMPT (QMATCHQ ←PGM
(PREVERSE $PGM)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT BEGINNING OF PROGRAM)
$$PGM
(TUPLE COMMENT END OF PROGRAM)))
(PRINT $PGM)
(PRINT (QUOTE "
LISP CODE ONLY"))
(PRINT (QUOTE "
"))
(PURE $PGM)
(TUPLE COMMENT END OF THIS REQUEST)))
(SETUP
(QLAMBDA ←ANYTHING
(DENYALL)
(UNQTRACE PURE)
(QASSERT (TUPLE RELN SUCC)
TYPE POSITIONAL EXTREME (TUPLE LAST ELEMENT)
NARGS 1 TARGS (TUPLE (TUPLE ANYELEMENT NOT LAST
ELEMENT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT
FIRST ELEMENT)))
(QASSERT (TUPLE RELN PRED)
TYPE POSITIONAL EXTREME (TUPLE FIRST ELEMENT)
NARGS 1 TARGS (TUPLE (TUPLE ANYELEMENT NOT
FIRST ELEMENT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT LAST
ELEMENT)))
(QASSERT (TUPLE RELN ENCLOSE)
TYPE ORDERING EXTREME
(TUPLE SINGLETON LIST OF THE FIRST ELEMENT)
NARGS 1 TARGS (TUPLE (TUPLE ANYELEMENT NOT))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT ATOM)))
(QASSERT (TUPLE RELN NUMERORDER)
TYPE ORDERING EXTREME (TUPLE SMALLEST ELEMENT)
NARGS 2 TARGS (TUPLE (TUPLE ANYELEMENT NOT)
(TUPLE ANYELEMENT NOT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT)))
(QASSERT (TUPLE RELN ALPHORDER)
TYPE ORDERING EXTREME (TUPLE CLOSEST ELEMENT
TO A)
NARGS 2 TARGS (TUPLE (TUPLE ANYELEMENT NOT)
(TUPLE ANYELEMENT NOT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT)))
[QASSERT (TUPLE RELN MIN)
TYPE SELECT EXTREME (QUOTE LOWERBOUND)
DOMAIN
(TUPLE SETS OF ANYTYPE NUMBERS)
RANGE
(TUPLE ANYTYPE NUMBER)
KNOWN T FACTS
[TUPLE (TUPLE FORALL Z IN ?DOMAIN
(TUPLE (TUPLE MIN ?DOMAIN)
LE Z))
(TUPLE (TUPLE TUPLE MIN Y SUCHTHAT ?GOAL)
BECOMES
[TUPLE TUPLE MAX Y SUCHTHAT
(TUPLE REPLACE
(TUPLE TUPLE Y
(TUPLE TUPLE
ADD1 Y)
INEXPRESSION
(TUPLE NEGATION
?GOAL]
IF (TUPLE TUPLE MONOTONEIN
(TUPLE TUPLE LIST
(TUPLE TUPLE QUOTE ?GOAL)
(TUPLE TUPLE QUOTE
(TUPLE TUPLE ADD1
Y]
COMPUTABLE
(EVAL (TUPLE LOWERBOUND ?RANGE))
DEFINITION
(QUOTE ((START Y AT LOWERBOUND ?RANGE)
(RECURSE WITH Y AT (ADD1 Y]
[QASSERT (TUPLE RELN MAX)
TYPE SELECT EXTREME (QUOTE UPPERBOUND)
DOMAIN
(TUPLE SETS OF ANYTYPE NUMBERS)
RANGE
(TUPLE ANYTYPE NUMBER)
KNOWN T FACTS
[TUPLE (TUPLE FORALL Z IN ?DOMAIN
(TUPLE Z LE (TUPLE MAX
?DOMAIN)))
(TUPLE (TUPLE TUPLE MAX Y SUCHTHAT ?GOAL)
BECOMES
[TUPLE TUPLE MIN Y SUCHTHAT
(TUPLE REPLACE
(TUPLE TUPLE Y
(TUPLE TUPLE
ADD1 Y)
INEXPRESSION
(TUPLE NEGATION
?GOAL]
IF (TUPLE TUPLE MONOTONEIN
(TUPLE TUPLE LIST
(TUPLE TUPLE QUOTE ?GOAL)
(TUPLE TUPLE QUOTE
(TUPLE TUPLE SUB1
Y]
COMPUTABLE
(EVAL (TUPLE UPPERBOUND ?RANGE))
DEFINITION
(QUOTE ((START Y AT UPPERBOUND ?RANGE)
(RECURSE WITH Y AT (TUPLE SUB1 Y]
[QASSERT (TUPLE RELN SQUARE)
TYPE NUM EXTREME (QUOTE UPPERBOUND)
DOMAIN
(TUPLE THE REAL NUMBERS)
RANGE
(TUPLE THE NONNEGATIVE REAL NUMBERS)
MONOTONE T KNOWN T FACTS
(TUPLE (TUPLE INVERSE IS SQUAREROOT))
COMPUTABLE T DEFINITION
(QUOTE (TUPLE LAMBDA (TUPLE X)
(TUPLE TIMES X X]
(QASSERT (TUPLE RELN SQUAREROOT)
TYPE NUM EXTREME (QUOTE (TUPLE LAMBDA (TUPLE XX)
1))
DOMAIN
(TUPLE THE NONNEGATIVE REAL NUMBERS)
RANGE
(TUPLE THE NONNEGATIVE REAL NUMBERS)
KNOWN T FACTS (TUPLE (TUPLE INVERSE IS SQUARE))
COMPUTABLE NIL DEFINITION NIL)
[QASSERT (TUPLE RELN GT)
TYPE PREDICATE NARGS 2 TARGS (TUPLE ANYNUMBER
ANYNUMBER)
NRES 1 TRES (TUPLE (TUPLE LOGICAL))
NEGATION LE EXTREME (TUPLE UPPERBOUND)
MONOTONE T COMPUTABLE T DEFINITION
(QUOTE (TUPLE LAMBDA (TUPLE A B)
(TUPLE A GT B]
[QASSERT (TUPLE RELN LE)
TYPE PREDICATE NARGS 2 TARGS (TUPLE ANYNUMBER
ANYNUMBER)
NRES 1 TRES (TUPLE (TUPLE LOGICAL))
NEGATION GT EXTREME (TUPLE LOWERBOUND)
MONOTONE T COMPUTABLE T DEFINITION
(QUOTE (TUPLE LAMBDA (TUPLE A B)
(TUPLE A LE B]
(QASSERT (TUPLE SCHEMA DOUBLEFN)
STANDARD T EXTREME (TUPLE SAMEASFN)
NARGS 1 TARGS
[TUPLE (TUPLE RELN NARGS 1 NRES 1
(EQUAL (CADADR TARGS)
(CADADR TRES]
NRES 1 TRES (TUPLE (TUPLE SAMEASFN NOT)))
(QASSERT (TUPLE RELN CAR)
TYPE DESTRUCTIVE EXTREME (TUPLE LEFTMOST ATOM)
NARGS 1 TARGS (TUPLE (TUPLE ANYLIST NOT NIL))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT)))
(QASSERT (TUPLE RELN CDR)
TYPE DESTRUCTIVE EXTREME (TUPLE NIL)
NARGS 1 TARGS (TUPLE (TUPLE ANYLIST NOT NIL))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT ATOM)))
(QASSERT (TUPLE RELN CONS)
TYPE CONSTRUCTIVE EXTREME (TUPLE ANYLIST)
NARGS 2 TARGS (TUPLE (TUPLE ANYELEMENT NOT)
(TUPLE ANYLIST NOT ATOM))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT)))
(QASSERT (TUPLE RELN APPEND)
TYPE CONSTRUCTIVE EXTREME (TUPLE ANYLIST)
NARGS 2 TARGS (TUPLE (TUPLE ANYLIST NOT ATOM)
(TUPLE ANYLIST NOT ATOM))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT)))
(QASSERT (TUPLE C A A3))
(QASSERT (TUPLE C B B3))
(QASSERT (TUPLE C C C3))
(QASSERT (TUPLE C D D3))
(QASSERT (TUPLE C E E3))
(QASSERT (TUPLE C F F3))
(QASSERT (TUPLE C G G3))
(QASSERT (TUPLE C I I3))
(QASSERT (TUPLE C J J3))
(QASSERT (TUPLE C K K3))
(QASSERT (TUPLE C H H3))
(QASSERT (TUPLE LIST L1 (TUPLE)))
(QASSERT (TUPLE LIST L2 (TUPLE)))
(QASSERT (TUPLE LIST L3 (TUPLE)))
(QASSERT (TUPLE LIST L4 (TUPLE A B C)))
(QASSERT (TUPLE LIST L5 (TUPLE D E)))
(QASSERT (TUPLE LESS I J))
(QASSERT (TUPLE LESS J K))
(QASSERT (TUPLE LESS H I))
(QPUT LESS ANTISYM T)
(QPUT LESS PARTIAL T)
(QPUT LESS TRANSITIVE T)
(TUPLE SETUP COMPLETED)
(QASSERT (TUPLE RELN ADD1)
COMPUTABLE T KNOWN T)
(QASSERT (TUPLE RELN SUB1)
COMPUTABLE T KNOWN T)))
(INIT
(QLAMBDA ←ANYTHING
(QMATCHQ ←GOALTYPE
(TUPLE ORGOAL ANDGOAL XORGOAL SERIESGOAL NONEOF
SIMPLEGOAL TRYANYTHINGANTISYMPARTIAL))
(QMATCHQ ←LITTLEGUYS
(TUPLE SETQC RPLAC CONSC MAKENULL TRANSITIVECLOSURE
REV2ELS RECURLIST RECURNUM))
(QMATCHQ ←PGM
(TUPLE))
(QMATCHQ ←UNUSEDVARS
(CLASS U1 U2 U3 U4 U5 U6 U7 U8 U9 U10 U11 U12 U13
U14 U15 U16 U17))
(QMATCHQ ←UNUSEDV
$UNUSEDVARS)
(QMATCHQ ←SIMPLIFY
(TUPLE SIMPLIFYSETQ SIMPLIFYNUMERIC SIMPLIFYAUXFN
SIMPLIFYNOTHING))
(QMATCHQ ←UNUSEDLABELS
(CLASS LABEL1 LABEL2 LABEL3 LABEL4 LABEL5 LABEL6
LABEL7 LABEL8 LABEL9 LABEL10))
(QMATCHQ ←UNUSEDFNS
(CLASS F1 F2 F3 F4 F5 F6 F7 F8 F9 F10))
(QMATCHQ ←UNUSEDARGS
(CLASS ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7 ARG8 ARG9
ARG10))
$ANYTHING))
(GETNEWLOCNAME
(QLAMBDA ←ANYTHING
(QPROG (←X)
(QMATCHQ (CLASS ←X
←←UNUSEDVARS)
$UNUSEDVARS)
(QRETURN $X))))
(DENYALL
[QLAMBDA ←ANYTHING
(QATTEMPT (QDELETE (TUPLE C ←C1
←V1)))
[QATTEMPT (QDELETE (TUPLE LIST ←L1
(TUPLE ←←V1]
(QATTEMPT (QDELETE (TUPLE LESS ←C1
←V1])
(SERIESGOAL
(QLAMBDA (TUPLE SERIES ←Z1
←←Z2)
(SETQ NEED NIL)
(SETQ REQUIRE NIL)
(QGOAL $Z1 APPLY $GOALTYPE)
(QIF (QEQUAL $Z2 (TUPLE))
THEN $PGM
ELSE (QGOAL (TUPLE SERIES $$Z2)
APPLY $GOALTYPE))))
(ORGOAL
(QLAMBDA (CLASS OR ←Z1
←←Z2)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT
FROM THE ORTASK WE JUST DID $Z1)
$$PGM))
ELSE (QGOAL (CLASS OR $$Z2)
APPLY $GOALTYPE))))
(ANDGOAL
[QLAMBDA (CLASS AND ←←Z)
(QPROG (←Z1
←Z2
←Z3)
(QMATCHQ ←Z3
(CLASS))
(QMATCHQ (CLASS ←Z1
←←Z2)
$Z)
(GO B2)
B1
(QMATCHQ (CLASS ←Z1
←←Z2)
$Z)
(QMATCHQ ←Z3
(CLASS $$Z3 $Z1))
(QMATCHQ ←Z
(CLASS $$Z2))
B2
(SETQ NEED T)
(SETQ REQUIRE T)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QIF (QEQUAL $Z2 (CLASS))
THEN (QIF (QEQUAL $Z3 (CLASS))
THEN $PGM
ELSE (QGOAL (CLASS AND $$Z3)
APPLY $GOALTYPE))
ELSE (QGOAL (CLASS AND $$Z2)
APPLY $GOALTYPE))
ELSE (GO B1])
(XORGOAL
(QLAMBDA (CLASS XOR ←Z1
←←Z2)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QATTEMPT (QGOAL (CLASS NONEOF $$Z2)
APPLY $GOALTYPE)
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT OF THE
EXCLUSIVE
OR GOAL WE DID
$Z1
AND NO OTHERS ARE
SATISFIED)
$$PGM)))
ELSE (QGOAL (CLASS XOR $$Z2)
APPLY $GOALTYPE))))
(BUILDPGM
[QLAMBDA (TUPLE ←NEWLOC
←NEWVAL
←OLDLOC)
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I JUST TRANSFERRED THE VALUE
$NEWVAL
FROM CELL $OLDLOC
TO CELL $NEWLOC)
(TUPLE SETQ $NEWLOC $OLDLOC)
$$PGM))
(QATTEMPT (QEXISTS (TUPLE C $NEWLOC ←OV))
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT $NEWLOC NO LONGER
HAS THE VALUE $OV)
$$PGM])
(GOBYEXAMPLE
(QLAMBDA ←BODY
(SETQ EX (GETEXAMPLE))
(SETQ BOD (NEWCARCDR $BODY))
(ERRORSET (EXECUTE BOD))
(SETQ XX (CONS (QUOTE TUPLE)
EX))
(QMATCHQ ←X
(EVAL XX))
(ASKABOUTALL (CLASS $X))))
(GETEXAMPLE
[LAMBDA NIL
(QUOTE (A B C])
(SAMEASFN
[LAMBDA (A)
A])
(DOUBLEFN
(QLAMBDA (TUPLE ←OLDARG
←REL)
(TUPLE $REL (TUPLE $REL $$OLDARG))))
(SYNTH1
(QLAMBDA ←A
(SELECTQ (CAR $A)
(NIL (TUPLE NULL $L))
(ATOM (TUPLE ATOM $L))
(FIRST (TUPLE NULL (TUPLE CDR $L)))
(LAST (TUPLE NULL (TUPLE CDR $L)))
(TUPLE EQUAL $L $$A))))
(SYNTH2
(QLAMBDA (TUPLE ←A
←B)
(COND
((NULL (CAR $B))
$B)
((EQUAL (CAR $B)
T)
$B)
((NUMBERP (CAR $B))
$B)
((EQUAL $A $B)
(TUPLE $L))
((EQUAL (LIST $A)
$B)
(TUPLE LIST $L))
((EQUAL (CAR $B)
(QUOTE FIRST))
(TUPLE (TUPLE CAR $L)))
(T (PRINT (QUOTE (I AM UNSURE ABOUT THE SYNTHESIS OF $B)))
$B))))
(ASKABOUT
[QLAMBDA
←A
(SELECTQ
(LENGTH $A)
(0 (PRINT (QUOTE (APPARENTLY NO FURTHER BASE STEP IS NEEDED
FOR SYNTACTIC REASONS)))
(IF (AND (QIN $NAME $BODY)
(NULL ONESTEP))
THEN (QAND (PRINT (QUOTE (BUT $NAME APPEARS
IN THE BODY OF THE DESIRED
FUNCTION $NAME)))
(PRINT (QUOTE (THUS I GIVE UP)))
(QFAIL)))
[IF (NULL ONESTEP)
THEN (PRINT (QUOTE (IT APPEARS THAT THE DEFINITION IS NOT
TRULY RECURSIVE
AND THUS I SHALL PROCEED]
$BODY)
(AND (PRINT (TUPLE
IF THE INPUT IS $A
THEN WHAT IS THE OUTPUT??))
(SETQ ONESTEP T)
(QMATCHQ ←TERM
(TUPLE [QCONS (SYNTH1 $A)
(SYNTH2
(TUPLE $A (TUPLE (CONS (RATOM)
(READLINE]
$$TERM])
(RHMATCH
(QLAMBDA (TUPLE ←←A
(TUPLE ←←B
NOT ←←C)←←D)
(TUPLE $A $B $C $D)
BACKTRACK))
(RECHEAD
[QLAMBDA ←BODY
(QPROG (←A
←B
←C
←D
←F
ONESTEP ←TERM
←FF
←B2
←IMP
←REST)
(QMATCHQ (TUPLE ←IMP
←←REST)
$BODY)
(QMATCHQ ←FF
(CLASS))
(SETQ ONESTEP NIL)
(QMATCHQ ←TERM
(TUPLE))
(QMATCHQ ←B2
(QGET (TUPLE RELN $IMP)
TARGS))
LOOP
(QATTEMPT (QMATCHQ (TUPLE ←A
←B
←C
←D)
(RHMATCH $B2))
THEN (AND (COND
((EQUAL (LENGTH $A)
0)
(QMATCHQ (TUPLE (TUPLE ←A2
←F
←←A4)←←A5)
$BODY))
((EQUAL (LENGTH $A)
1)
(QMATCHQ (TUPLE ←A1
(TUPLE ←A2
←F
←←A4)←←A5)
$BODY))
((EQUAL (LENGTH $A)
2)
(QMATCHQ (TUPLE ←A1
←A6
(TUPLE ←A2
←F
←←A4)←←A5)
$BODY))
(T (PRINT (QUOTE (LENGTH OF LIST NOT
ZERO
OR ONE
OR TWO
AS EXPECTED)))
(PRINT (CDR (TUPLE $A $F $BODY)))
(QFAIL)))
(QMATCHQ ←FF
(CLASS $C $$FF))
(QMATCHQ ←B2
(TUPLE $$A $$D))
(GO LOOP))
ELSE (TUPLE DEFINEQ
(TUPLE $NAME
(TUPLE LAMBDA (TUPLE $L)
(QATTEMPT (ASKABOUTALL
$FF)
THEN $AALH
ELSE (GOBYEXAMPLE
$BODY])
(EXTREMEPOSITION
(QLAMBDA ←RELATION
(QGET (TUPLE RELN $RELATION)
EXTREME)))
(EXTREMERELATIVEPOSITION
[QLAMBDA (TUPLE ←REL
←NEWARG
←OLDARG)
(QATTEMPT (QMATCHQ $NEWARG $OLDARG)
THEN (EXTREMEPOSITION $REL)
ELSE (AND (QMATCHQ ←TTEMP
(INVOLVES $NEWARG $OLDARG))
(QBEXISTS (TUPLE SCHEMA ←S)
STANDARD $TTEMP
THEN (QMATCHQ (TUPLE $REL $$OLDARG)
($S (TUPLE $NEWARG $REL)))
(APPLY* (CAR (QGET (TUPLE SCHEMA $S)
EXTREME))
(EXTREMEPOSITION $REL])
(POSITIONALJOIN
[QLAMBDA (TUPLE ←E2
←ABE2
←E1)
(QMATCHQ ←E2T
(LISPTRANSLATE $E2))
(QMATCHQ ←ABE2T
(LISPTRANSLATE $ABE2))
(QATTEMPT (QMATCHQ $E1 (TUPLE FIRST ELEMENT))
THEN (TUPLE CONS $E2T (TUPLE $NAME $ABE2T))
ELSE (QATTEMPT (QMATCHQ $E1 (TUPLE LAST ELEMENT))
THEN (TUPLE APPEND (TUPLE $NAME $ABE2T)
(TUPLE LIST $E2T))
ELSE (EVAL (PRINT (QUOTE (QFAIL])
(POSITIONAL
(QLAMBDA ←L
(QMATCHQ ←S
(TUPLE IDENTITY))
(QMATCHQ ←E1
(EXTREMEPOSITION $RELNN))
(QMATCHQ ←E2
(EXTREMERELATIVEPOSITION (TUPLE $RELNO $ARGSN
$ARGSO)))
(QMATCHQ ←PGM
(TUPLE (PRINT (TUPLE COMMENT
IN PARTICULAR THE $$E1 OF THE NEW
LIST IS THE $$E2 OF THE
OLD LIST $L))
$$PGM))
(QMATCHQ ←RECBODY
(POSITIONALJOIN (TUPLE $E2 (ALLBUT $E2)
$E1)))
(PRINT (QUOTE (THIS ENABLED US TO GET THE RECURSIVE BODY)))
(PRINT $RECBODY)
(PRINT (QUOTE (WE NOW DETERMINE THE TERMINATION STEPS)))
(QMATCHQ ←NEWFUNC
(RECHEAD $RECBODY))
(EVAL (PRINT $NEWFUNC))
(QMATCHQ ←PGM
(TUPLE $NEWFUNC $$PGM))))
(RECURLIST
[QLAMBDA
(TUPLE LIST ←L)
(QMATCHQ (CLASS ←NAME
←←UNUSEDFNS)
$UNUSEDFNS)
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I AM ABOUT
TO CONSTRUCT A POSSIBLY RECURSIVE NEW FUNCTION
WHICH I CHOOSE
TO CALL $NAME AND WHICH WILL TRANSFORM LISTS)
$$PGM))
(PRINT (TUPLE I AM ABOUT TO CONSTRUCT A POSSIBLY RECURSIVE FUNCTION
TO TRANSFORM LISTS))
(PRINT (TUPLE THE NAME I CHOOSE FOR THIS FUNCTION IS $NAME))
(PRINT (TUPLE THUS I NEED MORE INFORMATION ABOUT THE
OLD VERSUS THE NEW STRUCTURE OF LIST $L))
(PRIN1 (QUOTE "OLD.... "))
(/SETQ OLDLIST (CONS (RATOM)
(READLINE)))
(SETQ TEMPO (CONS (QUOTE TUPLE)
OLDLIST))
(QMATCHQ (TUPLE ←RELNO
←←ARGSO)
(EVAL TEMPO))
(PRIN1 (QUOTE "NEW.... "))
(/SETQ NEWLIST (CONS (RATOM)
(READLINE)))
(SETQ TEMPO (CONS (QUOTE TUPLE)
NEWLIST))
(QMATCHQ (TUPLE ←RELNN
←←ARGSN)
(EVAL TEMPO))
(QMATCHQ ←RELNTYPE
(QGET (TUPLE RELN $RELNN)
TYPE))
(QATTEMPT (OR (QMATCHQ $ARGSO (TUPLE))
(QMATCHQ $RELNTYPE (QGET (TUPLE RELN $RELNO)
TYPE)))
THEN (QAND (QMATCHQ ←PGM
(TUPLE (PRINT (TUPLE COMMENT WE KNOW THAT
THE INITIAL
TO FINAL TRANSFORMATION
INVOLVES SOLELY
$RELNTYPE CHANGES))
$$PGM))
($RELNTYPE $L)
(QMATCHQ ←PGM
(TUPLE (TUPLE $NAME $L)
(TUPLE COMMENT WE APPLY OUR NEW
FUNCTION $NAME
TO OUR GIVEN ARBITRARY LIST $L)
$$PGM)))
ELSE (QAND (QMATCHQ ←PGM
(TUPLE (PRINT (TUPLE COMMENT WE KNOW THAT THE
INITIAL
TO FINAL CHANGE INVOLVES A
MIXTURE OF BOTH $RELNTYPE
AND
(QGET (TUPLE RELN
$RELNO)
TYPE)
CHANGES))
$$PGM])
(MAKECOMPUTABLE
[QLAMBDA (TUPLE ←←L1)
(QPROG (←A1)
(QMATCHQ ←L2
$L1)
MCLOOP
(QATTEMPT (QMATCHQ (TUPLE ←A1
←←L2)
$L2)
THEN (IF [OR (EQUAL $A1 $X)
(EQUAL $A1 (QUOTE Y))
(EQUAL T (QGET (TUPLE RELN $A1)
COMPUTABLE))
(QMATCHQ ←L1
(MODIFYUSINGFACTS
(TUPLE $L1 $A1]
THEN (GO MCLOOP)
ELSE (RETURN (QFAIL)))
ELSE (RETURN $L1])
(MODIFYUSINGFACTS
[QLAMBDA (TUPLE ←L1
←A1)
(QPROG (←RNAME
←RARGS
←F
←ANY1
←ANY2)
(QMATCHQ (TUPLE ←RNAME
←←RARGS)
$A1)
[QATTEMPT (COND
((AND (EVAL (QGET (TUPLE RELN $RNAME)
COMPUTABLE))
(QMATCHQ (TUPLE ←WW)
$RARGS)
(MAKECOMPUTABLE $WW))
(RETURN $L1]
(QMATCHQ ←F
(QGET (TUPLE RELN $RNAME)
FACTS))
(QATTEMPT (QMATCHQ (TUPLE ←←ANY1
(TUPLE INVERSE IS ←INVFN)
←←ANY2)
?F)
THEN (INVERSESUBST $L1])
(INVERSESUBST
[QLAMBDA ←L
(QPROG (←REST)
(COND
((NULL $L)
(RETURN NIL)))
(QMATCHQ (TUPLE ←SEC
←←REST)
$L)
[QMATCHQ ←SEC
(COND
((EQUAL $SEC (QUOTE Y))
(TUPLE $INVFN Y))
((EQUAL $SEC $A1)
(CADR $A1))
((ATOM $SEC)
$SEC)
(T (CONS (INVERSESUBST (CAR $SEC))
(INVERSESUBST (CDR $SEC]
(RETURN (CONS $SEC (INVERSESUBST $REST])
(IMPLEMENT
[QLAMBDA
←DEF
(QATTEMPT (QMATCHQ (TUPLE QUOTE ←DEF)
$DEF)
THEN (PRINT (TUPLE
IN IMPLEMENT DEF IS $DEF AFTER STRIPPING QUOTE
OFF))
ELSE (PRINT (TUPLE
IN IMPLEMENT DEF IF $DEF AND IS NOT QUOTED)))
(PRINT (TUPLE THE DESCRIPTION WE FINALLY TRY
TO IMPLEMENT IS $DESC USING THE ALGORITHM $DEF))
(QPROG
NIL
[QATTEMPT (QMATCHQ (TUPLE ←DEF1
←←DEF2)
$DEF)
THEN (PRINT (TUPLE WE MATCH $DEF INTO THE TWO PIECES $DEF1
AND $$DEF2))
ELSE (RETURN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE JUST APPLIED OUR
NEW FUNCTION $NAME
TO ITS ORIGINAL INTENDED
ARGUMENT $ARG)
(TUPLE $NAME $ARG)
$$PGM]
(QATTEMPT (QMATCHQ (TUPLE START ←VAR
AT ←←INITIALVAL)
$DEF1)
THEN (AND (QMATCHQ (CLASS ←F
←←UNUSEDFNS)
$UNUSEDFNS)
(QASSERT (TUPLE RELN $F)
AUXFN T)
(QMATCHQ (TUPLE ←INITIALFN
←INITIALARG)
$INITIALVAL)
[QMATCHQ ←NEWFN
(TUPLE DEFINEQ
(TUPLE $NAME
(TUPLE LAMBDA (TUPLE $X)
(TUPLE SETQ $VAR
($INITIALFN
$INITIALARG))
(TUPLE $F $X $VAR]
(QMATCHQ ←PGM
(TUPLE $NEWFN
(TUPLE COMMENT WE WILL DEFINE $NAME
USING AN AUXILLIARY FUNCTION
OF TWO VARIABLES
(TUPLE THE ORIGINAL ARGUMENT
AND A COUNTER))
$$PGM))
(EVAL $NEWFN)
(IMPLEMENT2 (TUPLE $$DEF2 $F $X $VAR))
(RETURN (IMPLEMENT (TUPLE])
(IMPLEMENT2
(QLAMBDA
(TUPLE ←DEF
←NAME
←X
←VAR)
(QMATCHQ ←NEWFNBOD
$GOAL)
(QATTEMPT
(QMATCHQ (TUPLE RECURSE WITH $VAR AT ←EXPR)
$DEF)
THEN
[QPROG NIL
(QMATCHQ
←NEWFN
(TUPLE DEFINEQ
(TUPLE $NAME
(TUPLE LAMBDA (TUPLE $X $VAR)
(TUPLE COND (TUPLE $NEWFNBOD
$VAR)
(TUPLE T
(TUPLE $NAME $X
$EXPR]
ELSE
(QATTEMPT
(QMATCHQ (TUPLE RECURSE WITH $X AT $EXPR)
$DEF)
THEN
[QPROG
NIL
(QMATCHQ ←NEWFN
(TUPLE DEFINEQ
(TUPLE $NAME
(TUPLE LAMBDA (TUPLE $X $VAR)
(TUPLE COND (TUPLE
$NEWFNBOD
$VAR)
(TUPLE T
(TUPLE $NAME
$EXPR
$VAR]
ELSE (QFAIL)))
(EVAL $NEWFN)
(QMATCHQ ←PGM
(TUPLE $NEWFN
(TUPLE COMMENT WE DEFINE THE RECURSIVE FUNCTION
$NAME
AS FOLLOWS)
$$PGM))))
(LOWERBOUND
(QLAMBDA ←SET
(COND
((FINITE $SET)
(EXTREMORD (TUPLE $SET OPPOSITENUMORDER)))
((QATTEMPT (QMATCHQ (TUPLE THE POSITIVE ←←ANY)
$SET))
1)
((QATTEMPT (QMATCHQ (TUPLE THE NONNEGATIVE ←←ANY)
$SET))
0)
((QATTEMPT (QMATCHQ (TUPLE THE NATURAL NUMBERS)
$SET))
0)
((REASONTOGET (TUPLE LOWERBOUND)))
(T NIL))))
(OPPOSITENUMORDER
[LAMBDA (A B)
(ALPHORDER B A])
(HOLDS
(QLAMBDA ←CONDITION
(QMATCHQ (TUPLE ←FNH
←ARGH)
$CONDITION)
(SETQ ARGHH (EVAL $ARGH))
($FNH (EVAL ARGHH))))
(OBTAINRECURARGS
[QLAMBDA (TUPLE ←NAME
←INS)
(QPROG (←I1
←I2)
(QATTEMPT (QMATCHQ (TUPLE $NAME ←←RARGS)
$INS)
THEN $RARGS
ELSE (QATTEMPT (QMATCHQ (TUPLE ←I1
←←I2)
$INS)
THEN (OR (OBTAINRECURARGS (TUPLE $NAME $I1)
)
(OBTAINRECURARGS (TUPLE $NAME $I2)
))
ELSE (QMATCHQ ←RARGS
(TUPLE])
(NOTTOORECURSIVE
(QLAMBDA ←RECURARG
(IF (EQUAL $RECURARG (QATTEMPT (MAKECOMPUTABLE $RECURARG)))
THEN T
ELSE (QATTEMPT (QMATCHQ (TUPLE ←R1
←←R2)
$RECURARG)
THEN (AND (OR (AND $R2 (NOTTOORECURSIVE
(TUPLE $R1)))
(NOTTOORECURSIVE $R1))
(NOTTOORECURSIVE $R2))
ELSE NIL))))
(SIMPLIFYNOTHING
(QLAMBDA (TUPLE SIMPLE ←←ANYTHING)
$ANYTHING))
(INCTEST
(QLAMBDA (TUPLE ←FN1
←COMPAR)
(QMATCHQ (TUPLE ←←B1
(TUPLE DEFINEQ (TUPLE $FN1
(TUPLE ←LAMB1
←ARGS1
←←INSTRUCS1)))
←←B2)
$COMPAR)))
(INVESTIGATE
(QLAMBDA ←V
(IF (ZEROP (LENGTH $V))
THEN (QGOAL (TUPLE SIMPLE $V)
APPLY $SIMPLIFY)
ELSE (QGOAL (TUPLE SIMPLE $$V)
APPLY $SIMPLIFY))))
(SIMPLIFYSETQ
(QLAMBDA (TUPLE SIMPLE SETQ ←CELL
←VALUE)
(TUPLE SETQ $CELL (INVESTIGATE $VALUE))))
(SIMPLIFYNUMERIC
[QLAMBDA (TUPLE SIMPLE ←NUM)
(COND
((NUMBERP $NUM)
$NUM)
((ZEROP (LENGTH $NUM))
(PRINT (TUPLE NO $NUM IS AN ATOM ALL RIGHT BUT NOT A
NUMBER))
(QFAIL))
(T (QFAIL])
(SIMPLIFYAUXFN
[QLAMBDA (TUPLE SIMPLE ←FN
←←ARGS)
(COND
((EQUAL T (QGET (TUPLE RELN $FN)
AUXFN)))
(T (QFAIL)))
(PUSHVARS)
(QMATCHQ ←NEWA1
(QATTEMPT (OPTIMIZE (TUPLE $FN $A1))
ELSE ?HOLDA1))
(QMATCHQ ←NEWA2
(QATTEMPT (OPTIMIZE (TUPLE $FN ?HOLDA2))
ELSE ?HOLDA2))
(POPVARS)
(QMATCHQ ←A1
$NEWA1)
(QMATCHQ ←A2
$NEWA2)
(QATTEMPT (TRYTOINCORPORATE (TUPLE $FN INTO $NAME])
(TRYTOINCORPORATE
(QLAMBDA (TUPLE ←FN1
INTO ←FN2)
(INCTEST (TUPLE $FN1 (TUPLE $$A1 $$A2)))
(IF (MEMBER $FN1 (FLATTEN $INSTRUCS1))
THEN (AND (PRINT (TUPLE $FN1 HAS THE RECURSIVE BODY
$INSTRUCS1))
(QFAIL)))
(QATTEMPT (INCTEST (TUPLE $FN1 $A1))
THEN (QMATCHQ ←A1
(TUPLE $$B1 $$B2))
ELSE (IF (INCTEST (TUPLE $FN1 $A2))
THEN (QMATCHQ ←A2
(TUPLE $$B1 $$B2))
ELSE (QFAIL)))
(QMATCHQ (TUPLE ←←AX1
(TUPLE $FN1 ←←FN1ARGS)←←AX2)
$INSTRUCS)
(QMATCHQ ←INSTRUCS
(TUPLE $$AX1 $$INSTRUCS1 $$AX2))))
(OPTIMIZE
(QLAMBDA (TUPLE ←NAMEO
(TUPLE ←←A1O
(TUPLE DEFINEQ (TUPLE ←NAMEO
(TUPLE ←LAMB
←ARGS
←←INSTRUCSO)))
←←A2O))
(QMATCHQ ←A1
$A1O)
(QMATCHQ ←NAME
$NAMEO)
(QMATCHQ ←INSTRUCS
$INSTRUCSO)
(QMATCHQ ←A2
$A2O)
(SETQ ELS (FLATTEN $INSTRUCS))
(IF (MEMBER $NAME ELS)
THEN (TRYTOELIMRECURSION)
ELSE (PRINT (TUPLE $NAME IS NOT RECURSIVE AS CURRENTLY
DEFINED)))
(SETQ INSTRU $INSTRUCS)
[FOR VVVV IN INSTRU
DO (IF (MEMBER (CAR VVVV)
(TUPLE DEFINEQ LAMBDA (TUPLE)
QLAMBDA $ARG $X Y))
ELSE (COND
(VVVV (AND (QMATCHQ ←VV
(INTUPLE VVVV))
(INVESTIGATE $VV)))
(T T]
(TUPLE $$A1 (TUPLE DEFINEQ (TUPLE $NAME
(TUPLE $LAMB $ARGS
$$INSTRUCS)))
$$A2)))
(TRYTOELIMRECURSION
[QLAMBDA ←ANYTHING
(SETQ MULT 0)
[FOR W IN ELS DO (IF (EQUAL W $NAME)
THEN (SETQ MULT (ADD1 MULT]
(PRINT (TUPLE MULTIPLICITY OF SELF RECURSION OF $NAME IS
(EVAL MULT)))
(SELECTQ MULT
(0 (PRINT (TUPLE $NAME NO LONGER RECURSIVE)))
[1 (SETQ R (OBTAINRECURARGS (TUPLE $NAME $INSTRUCS))
)
(QATTEMPT [FOR RA IN R
DO (NOTTOORECURSIVE
(TUPLE (EVAL RA]
THEN (REARRANGE $NAME)
ELSE (PRINT (TUPLE ARGS OF $NAME
IN RECURSIVE CALL ARE JUST TOO
INHERENTLY RECURSIVE
THEMSELVES
TO ALLOW US
TO SIMPLY REARRANGE $INSTRUCS]
(PRINT (TUPLE $NAME CALLS ITSELF TOO MANY TIMES
IN ITS DEFINITION SO I GIVE UP])
(REARRANGE
[QLAMBDA
←NAME
(QMATCHQ (CLASS ←LABEL
←←UNUSEDLABELS)
$UNUSEDLABELS)
(SETQ INS NIL)
(FOR
II IN $INSTRUCS
DO
(SETQ INS
(APPEND
[QATTEMPT
(QMATCHQ (TUPLE $NAME ←←RARGS)
II)
THEN
[QPROG
NIL
(SETQ JCOL NIL)
(FOR
JJ IN $RARGS
DO
(SETQ JCOL
(APPEND
(IF
(ATOM JJ)
THEN NIL
ELSE
(QATTEMPT
(QMATCHQ (TUPLE ←JFN
←JARG)
JJ)
THEN (TUPLE SETQ $JARG (EVAL JJ))
ELSE (AND (PRINT (TUPLE COMMENT
REARRANGE
UNSURE ABOUT
(EVAL JJ)))
JJ)))
JCOL)))
(RETURN (TUPLE AND (EVAL JCOL)
(TUPLE GO $LABEL]
ELSE (IF (ATOM II)
THEN II
ELSE (REARRANGE2 (QMATCHQ ←III
II]
INS)))
(QMATCHQ ←INSTRUCS
(TUPLE (TUPLE QPROG (TUPLE)
$LABEL
(EVAL INS])
(REARRANGE2
(QLAMBDA
←L
(QPROG
(←LA
←LB
JCOL ←CAR
←CDR)
(QATTEMPT
(QMATCHQ (TUPLE ←LA
←←LB)
$L)
THEN
(CONS
[QATTEMPT
(QMATCHQ (TUPLE $NAME ←←RARGS)
$LA)
THEN
(QPROG
NIL
(SETQ JCOL NIL)
(FOR
JJ IN $RARGS
DO
(SETQ JCOL
(APPEND
(IF
(ATOM JJ)
THEN NIL
ELSE
(QATTEMPT
(QMATCHQ (TUPLE ←JFN
←JARG)
JJ)
THEN (TUPLE SETQ $JARG (EVAL JJ))
ELSE
(AND (PRINT (TUPLE COMMENT REARRANGE2
UNSURE ABOUT
(EVAL JJ)))
JJ)))
JCOL)))
(QMATCHQ ←RR1
JCOL)
(QMATCHQ ←RR2
(TUPLE GO $LABEL))
(QMATCHQ ←RR3
(LIST (QUOTE AND)
$RR1 $RR2))
(RETURN $RR3))
ELSE (IF (ZEROP (LENGTH $LA))
THEN $LA
ELSE (AND (QMATCHQ (TUPLE ←CAR
←←CDR)
$LA)
(CONS (REARRANGE2 $CAR)
(REARRANGE2 $CDR]
(REARRANGE2 $LB))
ELSE $L))))
(POPVARS
(QLAMBDA ←ANYTHING
(PRINT (TUPLE NAME ?NAME ?HOLDNAME A1 ?A1 ?HOLDA1 A2 ?A2
?HOLDA2 ARGS ?ARGS ?HOLDARGS INSTRUCS
?INSTRUCS))
(QMATCHQ ←NAME
?HOLDNAME)
(QMATCHQ ←A1
?HOLDA1)
(QMATCHQ ←A2
?HOLDA2)
(QMATCHQ ←ARGS
?HOLDARGS)
(QMATCHQ ←INSTRUCS
?HOLDI)))
(PUSHVARS
(QLAMBDA ←ANYTHING
(PRINT (TUPLE NAME ?NAME ?HOLDNAME A1 ?A1 ?HOLDA1 A2 ?A2
?HOLDA2 ARGS ?ARGS ?HOLDARGS HOLDINSTRUCS
?HOLDI))
(QMATCHQ ←HOLDNAME
?NAME)
(QMATCHQ ←HOLDA1
?A1)
(QMATCHQ ←HOLDA2
?A2)
(QMATCHQ ←HOLDARGS
?ARGS)
(QMATCHQ ←HOLDI
?INSTRUCS)))
(INTUPLE
[LAMBDA (L)
(COND
((NULL L)
(QUOTE (TUPLE)))
((ATOM L)
L)
((EQUAL L (QUOTE (NIL)))
NIL)
(T (CONS (QUOTE TUPLE)
(FOR LL IN L COLLECT (INTUPLE LL])
)
(LISPXPRINT (QUOTE PUPFNS)
T)
(RPAQQ PUPFNS
(PURE RAMIFICATIONS OUTTUPLE EXECUTE LISPTRANSLATE REV2ELS
CELLEQUAL LISTEQUAL PULLOUT NUMERORDER EXTREMORD
ORDERING EXTREMEORDERING NEWCDR REASONTOGET FINITE
UPPERBOUND MONOTONEIN NEGATION PREVERSE SQUARE REPLACE
NOTENEWFORM RECURNUM NEWRECURNUM NEWCAR NEWCARCDR
ASKABOUTALL NONEOF INVOLVES FLATTEN INSIDEC SUBLISTC
APPENDC REPLACECDR REPLACECAR MAKENULL RPLAC NEWCELL
ALLBUT STORECVALUE CONSC SETQC TRANSITIVECLOSURE
TRYANYTHINGANTISYMPARTIAL SIMPLEGOAL SOLVE SETUP INIT
GETNEWLOCNAME DENYALL SERIESGOAL ORGOAL ANDGOAL XORGOAL
BUILDPGM GOBYEXAMPLE GETEXAMPLE SAMEASFN DOUBLEFN SYNTH1
SYNTH2 ASKABOUT RHMATCH RECHEAD EXTREMEPOSITION
EXTREMERELATIVEPOSITION POSITIONALJOIN POSITIONAL
RECURLIST MAKECOMPUTABLE MODIFYUSINGFACTS INVERSESUBST
IMPLEMENT IMPLEMENT2 LOWERBOUND OPPOSITENUMORDER HOLDS
OBTAINRECURARGS NOTTOORECURSIVE SIMPLIFYNOTHING INCTEST
INVESTIGATE SIMPLIFYSETQ SIMPLIFYNUMERIC SIMPLIFYAUXFN
TRYTOINCORPORATE OPTIMIZE TRYTOELIMRECURSION REARRANGE
REARRANGE2 POPVARS PUSHVARS INTUPLE))
(LISPXPRINT (QUOTE PUPVARS)
T)
[RPAQQ PUPVARS (CGG CG NEED FACTS REQUIRE $PGM $UNUSEDARGS $UNUSEDFNS
$UNUSEDVARS (P (QSETUP PUPVARS))
(P (SETUP)
(INIT)
(PRINT (QUOTE (READY TO BEGIN PUP]
(RPAQQ CGG
(QA4:PURE QA4:RAMIFICATIONS OUTTUPLE EXECUTE QA4:LISPTRANSLATE
QA4:REV2ELS QA4:CELLEQUAL QA4:LISTEQUAL PULLOUT
NUMERORDER QA4:EXTREMORD QA4:ORDERING
QA4:EXTREMEORDERING NEWCDR NEWCAR NEWCARCDR
QA4:ASKABOUTALL QA4:INVOLVES FLATTEN INSIDEC
SUBLISTC QA4:APPENDC QA4:REPLACECDR QA4:REPLACECAR
QA4:MAKENULL QA4:RPLAC QA4:NEWCELL QA4:ALLBUT
QA4:STORECVALUE QA4:CONSC QA4:SETQC
QA4:TRANSITIVECLOSURE QA4:TRYANYTHINGANTISYMPARTIAL
QA4:SIMPLEGOAL QA4:SOLVE QA4:SETUP QA4:INIT
QA4:GETNEWLOCNAME QA4:DENYALL QA4:SERIESGOAL
QA4:ORGOAL QA4:ANDGOAL QA4:XORGOAL QA4:BUILDPGM
QA4:GOBYEXAMPLE GETEXAMPLE SAMEASFN QA4:DOUBLEFN
QA4:SYNTH1 QA4:SYNTH2 QA4:ASKABOUT QA4:RHMATCH
QA4:RECHEAD QA4:EXTREMEPOSITION
QA4:EXTREMERELATIVEPOSITION QA4:POSITIONALJOIN
QA4:POSITIONAL QA4:RECURLIST))
(RPAQQ CG
(PURE RAMIFICATIONS OUTTUPLE EXECUTE LISPTRANSLATE REV2ELS
CELLEQUAL LISTEQUAL PULLOUT NUMERORDER EXTREMORD
ORDERING EXTREMEORDERING NEWCDR NEWCAR NEWCARCDR
ASKABOUTALL INVOLVES FLATTEN INSIDEC SUBLISTC APPENDC
REPLACECDR REPLACECAR MAKENULL RPLAC NEWCELL ALLBUT
STORECVALUE CONSC SETQC TRANSITIVECLOSURE
TRYANYTHINGANTISYMPARTIAL SIMPLEGOAL SOLVE SETUP INIT
GETNEWLOCNAME DENYALL SERIESGOAL ORGOAL ANDGOAL XORGOAL
BUILDPGM GOBYEXAMPLE GETEXAMPLE SAMEASFN DOUBLEFN SYNTH1
SYNTH2 ASKABOUT RHMATCH RECHEAD EXTREMEPOSITION
EXTREMERELATIVEPOSITION POSITIONALJOIN POSITIONAL
RECURLIST))
(RPAQQ NEED NIL)
(RPAQQ FACTS FACTS)
(RPAQQ REQUIRE NIL)
(RPAQQ $PGM NIL)
(RPAQQ $UNUSEDARGS
(CLASS ARG8 ARG9 ARG10 ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7))
(RPAQQ $UNUSEDFNS
(CLASS F3 F4 F5 F6 F7 F8 F9 F10 F1 F2))
(RPAQQ $UNUSEDVARS
(CLASS U13 U15 U11 U16 U17 U1 U5 U6 U2 U3 U4 U8 U10 U7 U12 U9
U14))
(QSETUP PUPVARS)
(SETUP)
(INIT)
(PRINT (QUOTE (READY TO BEGIN PUP)))
STOP